home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr51 / lib201.zip / ERRLOG.PRG < prev    next >
Text File  |  1993-02-23  |  16KB  |  421 lines
  1. PROCEDURE ErrorLog
  2. *-------------------------------------------------------------------------------
  3. *-- Programmer : Peter Ripaldi (CIS: 70711,3420) (1-508-683-4987)
  4. *-- Date       : 08/23/1992
  5. *-- Notes      : Program to produce an error log on disk that is about
  6. *--            : 12k long. The idea is to provide as much information as
  7. *--            : possible about the system at the time of the error. On
  8. *--            : error you can print the screen to printer and/or disk
  9. *--            : if you uncomment the section(s). The error log on
  10. *--            : disk is called ERROR.LOG, each error session will
  11. *--            : add to the bottom of the previous error.
  12. *--            : Any suggestion to add, or if it helps
  13. *--            : let me know. Happy Erroring ?
  14. *-- Written for: dBASE IV 1.5  08/23/92
  15. *-- Rev. Hist. : 04/09/92 1.0 - none-  format from E_LOG.PRG
  16. *--            : Ideas from E_LOG.PRG    author unknown
  17. *--            :            ERR_TRAP.PRG author BILLG (BORBBS)
  18. *--            :            SPY_CAM      author dbf magazine
  19. *--            : 08/23/92 1.5 Added functions for ver 1.5
  20. *--            :              Save to screen before error msg on screen 
  21. *--            :              Append print screen to end of ERROR.LOG file
  22. *--            :              Send network msg, idea from Bob(IVYBURT) 
  23. *--            : 11/13/1992 -- modified seriously by Ken Mayer, allowing
  24. *--                            programmer calls to PRINTSCR and SCREEN, as
  25. *--                            well as network, by passing parms to the routine.
  26. *--                            Cleaned up the programming a lot. Removed 
  27. *--                            the need for as many memvars.
  28. *--              *****************************
  29. *--              *** REQUIRES PRINTSCR.BIN ***
  30. *--              ***  and     SCREEN.BIN   ***
  31. *--              *****************************
  32. *-- Calls......: SURROUND()    Function below
  33. *--              CENTER        Procedure below
  34. *-- Called by..: Any
  35. *-- Usage......: on error do ErrorLog with error(),lineno(),program(),;
  36. *--                  alias(),memory()[,<lPrntScrn>[,<lScrn2Disk>[,<cNetId>]]]
  37. *-- Example....: on error do errorlog with error(),lineno(),program(),alias(),;
  38. *--                  memory(),.t.,.t.,"MAYER"
  39. *-- Returns....: None
  40. *-- Parameters.: error()    = dBASE Function
  41. *--              lineno()   = dBASE Function
  42. *--              program()  = dBASE Function
  43. *--              alias()    = dBASE Function
  44. *--              memory()   = dBASE Function
  45. *--              lPrntScrn  = logical -- print the screen?
  46. *--              lScrn2Disk = logical -- print the screen to disk?
  47. *--              cNetId     = Network ID for user on a NOVELL NETWORK
  48. *--                           to send a Network message to letting them
  49. *--                           know about this error.
  50. *-------------------------------------------------------------------------------
  51.    *-- Try to bring in as much of system before loading anything else
  52.    PARAMETER nError,nLineNo,cProgram,cAlias,nMemory,lPrntScrn,lScrn2Disk,cNetId
  53.  
  54.    *-- talk off so answers to IIF() dont go in ERROR.LOG file
  55.    cTalk = set("TALK")
  56.    set talk off
  57.  
  58.     *-- deal with optional parameters
  59.     nParms = pCount()  && how many parameters were passed?
  60.     if nParms < 8      && no Net Id
  61.         cNetId = ""
  62.     endif
  63.     if nParms < 7      && no lScrn2Disk parm
  64.         lScrn2Disk = .f.
  65.     endif
  66.     if nParms < 6      && no Print Screen parm
  67.         lPrntScrn = .f.
  68.     endif
  69.     
  70.    *-- Get copy of screen so we can restore it after were done
  71.    save screen to sError
  72.    activate screen
  73.  
  74.    *-- set up disk file ERROR.LOG
  75.    set alternate to
  76.  
  77.     *-- Let user know SOMETHING'S happening
  78.     x=surround(12,25,"rg+/r","An Error Has Occured -- Writing Log")
  79.     
  80.    *-- If already there add to it, incase of more errors next time runs prg
  81.    if file("ERROR.LOG")
  82.       set alternate to error.log additive
  83.    else
  84.    *-- If not there make one
  85.       set alternate to error.log
  86.    endif && file("ERROR.LOG")
  87.  
  88.    *-- Turn on ERROR.LOG file
  89.    set alternate on
  90.  
  91.    *-- Turn screen off
  92.    set console off
  93.  
  94.    *-- set date to 19xx format
  95.    set century on
  96.  
  97.    *-- Begin error logging information to disk
  98.    *
  99.    * Set up heading
  100.  ? "=========================================================================="
  101.  ? "=====                   Begin Errors Found                           ====="
  102.  ? "====="
  103.  ?? SPACE(10)+CDOW(DATE())+SPACE(10)+MDY(DATE())+SPACE(10)+(TIME())
  104.  ?? "  ====="
  105.  ? "=========================================================================="
  106.  ?
  107.  ? " Error / Program Information"
  108.  ? "------------------------------"
  109.  ? "    Error #      : " + LTRIM(STR(nError)) +"  "+ MESSAGE()
  110.  ? "    In Program   : " + cProgram
  111.  ? "    On Line #    : " + LTRIM(STR(nLineNo))
  112.  ? "    Catalog Name : " + LTRIM(CATALOG())
  113.  ?
  114.  ?
  115.  
  116.  ? " System Information"
  117.  ? "------------------------------"
  118.  ? "    Memory          : " + LTRIM(STR(nMemory))
  119.  ? "    Diskspace       : " + LTRIM(STR(DISKSPACE()))
  120.  ? "    Path            : " + GETENV("path")
  121.  ? "    Prompt          : " + GETENV("prompt")
  122.  ? "    ComSpec         : " + GETENV("comspec")
  123.  ? "    Operating Sys   : " + LTRIM(OS())
  124.  ? "    Dbase Version   : " + LTRIM(VERSION(0))
  125.  ? "    Dbase Path      : " + LTRIM(HOME())
  126.  ? "    Compile Error   : " + LTRIM(STR(CERROR()))
  127.  ? "    Color system    : " + iif(iscolor(),"Yes","No") 
  128.  ?
  129.  ?
  130.  
  131.  ? "  Database File Information "
  132.  ? "------------------------------"
  133.  ? "    DBF File        : " + DBF()
  134.  ? "    Alias Name      : " + cAlias
  135.  ? "    Work area       : " + LTRIM(STR(SELECT()))
  136.  ? "    Order           : " + ORDER()
  137.  ? "    Record #        : " + LTRIM(STR(RECNO()))
  138.  ? "    Field count     : " + LTRIM(STR(FLDCOUNT()))
  139.  ? "    Tag name        : " + LTRIM(TAG())
  140.  ? "    Tag count       : " + LTRIM(STR(TAGCOUNT()))
  141.  ? "    Tag number      : " + LTRIM(STR(TAGNO()))
  142.  ? "    MDX file        : " + LTRIM(MDX())
  143.  ? "    NDX file        : " + LTRIM(NDX())
  144.  ? "    Descending index: " + iif(descending(),"Yes","No") 
  145.  ?
  146.  ? "    For condition of mdx tag  : " + LTRIM(FOR())
  147.  ? "    Expression of mdx/ndx tag : " + LTRIM(KEY())
  148.  ? "    Unique Index              : " + iif(unique(),"Yes","No") 
  149.  ? "    Deleted                   : " + iif(deleted(),"Yes","No") 
  150.  ? "    Record Count              : " + LTRIM(STR(RECCOUNT()))
  151.  ?
  152.  *-- record size may not be right add 35 for header if wanted
  153.  ? "    Record Size     : " + LTRIM(STR(RECSIZE()))
  154.  ? "    Last Update     : " + DTOC(LUPDATE())
  155.  ? "    Last Seek Found : " + iif(found(),"Yes","No") 
  156.  ? "    End Of File     : " + iif(eof(),"Yes","No") 
  157.  ? "    Begin Of File   : " + iif(bof(),"Yes","No") 
  158.  ?
  159.  ?
  160.  
  161.  ? "  Program Information "
  162.  ? "------------------------------"
  163.  ? "    Number of parameters called : " + LTRIM(STR(PCOUNT()))
  164.  ?
  165.  ?
  166.  
  167.  ? " File / User / Network  Information"
  168.  ? "------------------------------"
  169.  ? "    On Network             : " + iif(network(),"Yes","No") 
  170.  ? "    DBF in state of change : " + iif(ismarked(),"Yes","No") 
  171.  ? "    User Access Level      : " + LTRIM(STR(ACCESS()))
  172.  ? "    Log in User Name       : " + USER()
  173.  ? "    Name of current User   : " + ID()
  174.  ? "    Changed by others      : " + iif(change(),"Yes","No") 
  175.  ? "    Completed Transaction  : " + iif(completed(),"Yes","No") 
  176.  ? "    Rollback  Successful   : " + iif(rollback(),"Yes","No") 
  177.  ? "    Record Lock            : " + iif(rlock(),"Yes","No") 
  178.  ? "    File Lock              : " + iif(flock(),"Yes","No") 
  179.  ? 
  180.  ?
  181.  ? " List of Users  "
  182.  ? "--------------------------------"
  183.  list users
  184.  ?
  185.  ?
  186.  ? " Screen Information "
  187.  ? "------------------------------"
  188.  ? "    Window        : " + WINDOW()
  189.  ? "    Pad           : " + PAD()
  190.  ? "    Popup         : " + POPUP()
  191.  ? "    Bar #         : " + LTRIM(STR(BAR()))
  192.  ? "    Prompt        : " + PROMPT()
  193.  ? "    Menu          : " + MENU()
  194.  ? "    Cursor Row    : " + LTRIM(STR(ROW()))
  195.  ? "    Cursor Column : " + LTRIM(STR(COL()))
  196.  ?
  197.  ?
  198.  
  199.  ? " Key Stroke Information "
  200.  ? "------------------------------"
  201.  ? "    Varread       : " + VARREAD()
  202.  ? "    Inkey         : " + LTRIM(STR(INKEY()))
  203.  ? "    Lastkey       : " + LTRIM(STR(LASTKEY()))
  204.  ? "    Readkey       : " + LTRIM(STR(READKEY()))
  205.  ?
  206.  
  207.  ? " Printer Information "
  208.  ? "------------------------------"
  209.  ? "    Print Status     : " + iif(printstatus(),"Yes","No") 
  210.  ? "    Print Column     : " + LTRIM(STR(PCOL()))
  211.  ? "    Print Row        : " + LTRIM(STR(PROW()))
  212.  ?
  213.  ?
  214.  
  215.  * List  Status, Memory, History .....
  216.  ? " Status Listing "
  217.  ? "----------------------------------------------"
  218.  ?
  219.  ?
  220.  list status
  221.  
  222.  ? " Memory Listing "
  223.  ? "----------------------------------------------"
  224.  ?
  225.  ?
  226.  list memory
  227.  ?
  228.  ?
  229.  
  230.  ? " History Listing "
  231.  ? "------------------------------------------------"
  232.  list history
  233.  ?
  234.  ?
  235.  * End of errors for this time
  236.  ? "=========================================================================="
  237.  ? "=====                  End of Errors Found                           ====="
  238.  ? "====="
  239.  ?? space(10)+cdow(date())+space(10)+mdy(date())+space(10)+(time())
  240.  ?? "  ====="
  241.  ? "=========================================================================="
  242.  * spaces to seperate error log for next time error happens
  243.  ?
  244.  ?
  245.  ?
  246.  ?
  247.  *-- All done with saving file close up error file
  248.    set alternate off
  249.    set alternate to
  250.    set console on
  251.    set century off
  252.  
  253.    *-----------------------------------------------------------------------
  254.     *-- optional stuff here
  255.     *-----------------------------------------------------------------------
  256.     restore screen from sError  && remove message to user ...
  257.    if lPrntScrn
  258.        *-- Print Screen First, uses printscr.bin
  259.       load printscr
  260.       call printscr
  261.       release module printscr
  262.    endif
  263.  
  264.    *-----------------------------------------------------------------------
  265.    *-- Print screen to disk?
  266.    *-----------------------------------------------------------------------
  267.    * Print screen to disk file called Erscreen.txt,  uses screen.bin 
  268.    * The "a" option will append to text file
  269.    if lScrn2Disk
  270.       load screen
  271.       call screen with "a", "Erscreen.txt"
  272.       release module screen
  273.       eject   && form feed to clear out printer ...
  274.  
  275.      *- Add screen to end of ERROR.LOG file
  276.      set alternate to error.log additive
  277.  
  278.      *-- Turn screen off
  279.      set console off
  280.  
  281.      *-- turn on ERROR.LOG file for heading
  282.      set alternate on
  283.      ? "Screen Dump of above error"
  284.      ? "-----------------------------------------------"
  285.      ?
  286.      *-- All done with heading close up ERROR.LOG file
  287.      set alternate off
  288.      set alternate to
  289.  
  290.      *-- Now add screen to end of ERROR.LOG file
  291.      load screen
  292.      call screen with "a", "ERROR.LOG"
  293.      release module screen
  294.      *-- all done 
  295.      set console on
  296.    endif  && lScrn2File
  297.  
  298.   *------------------------------------------------------------------------
  299.   *-- After all that, let's let the user know what happened
  300.   *------------------------------------------------------------------------
  301.   * For real fun use one of KenMayer's "Death March" Songs (MISC.PRG)
  302.   * Alert user for heart attack, Give a tone
  303.   set bell to 500,5
  304.   ?? chr(7)
  305.   set bell to 400,4
  306.   ?? chr(7)
  307.   *set bell to 500,5
  308.   *?? chr(7)
  309.   *set bell to 400,5
  310.   *?? chr(7)
  311.   *set bell to 500,5
  312.   *?? chr(7)
  313.   set bell to
  314.  
  315.    *-- Give user message, on error window
  316.    define window wError from 0,0 to 24,79 double
  317.    activate window wError
  318.    *-- sample message inspired by movie China Syndrome
  319.     do center with 6,80,"rg+/r","** E R R O R  L O G **"
  320.    do center with 10,80,"","An unscheduled event has happened."
  321.    do center with 12,80,"","The information has been stored to disk. "
  322.    do center with 14,80,"","Notify Programmer Immediately!"
  323.    do center with 16,80,"","You are being returned to the dot prompt, or"
  324.    do center with 18,80,"","(if using RUNTIME) being dropped to DOS."
  325.    do center with 20,80,"","Press a key to continue ..."
  326.    *-- Wait until user sees message
  327.    x=inkey(0) 
  328.  
  329.    *------------------------------------------------------------------
  330.    *-- Network message to programmer?
  331.    *------------------------------------------------------------------
  332.    if .not. isblank(cNetId)
  333.         * From Bob (IVYBURT)
  334.         * If you're on a network, option to send a message to network manager
  335.         * to notify of mentally deranged program.
  336.  
  337.      if network()=.t.
  338.         !SEND &cNetId " Help -- Program Crashed!" 
  339.      endif  && network()
  340.    endif  && .not. isblank(cNetId)
  341.  
  342.    *------------------------------------------------------------------
  343.    *-- done with window, shut-down
  344.    *------------------------------------------------------------------
  345.    deactivate window wError
  346.    release window wError
  347.    clear all
  348.    release all
  349. clear
  350. Cancel         && rather than returning user to where they were
  351.  
  352. *-------------------------------------------------------------------------------
  353. *-- Extra Functions called from above ...
  354. *-------------------------------------------------------------------------------
  355.  
  356. PROCEDURE Center
  357. *-------------------------------------------------------------------------------
  358. *-- Programmer..: Miriam Liskin
  359. *-- Date........: 05/24/1991
  360. *-- Notes.......: Centers text on the screen with @says
  361. *-- Written for.: dBASE IV, 1.1
  362. *-- Rev. History: This and all other procedures/functions listed in this
  363. *--               file attributed to Miriam Liskin came from "Liskin's
  364. *--               Programming dBASE IV Book". Very good, worth the money.
  365. *-- Calls.......: None
  366. *-- Called by...: Any
  367. *-- Usage.......: do center with <nLine>,<nWidth>,"<cColor>","<cText>"
  368. *-- Example.....: do center with 5,65,"RG+/GB","WARNING! This will blow up!"
  369. *--                  Note that the color field may be blank: ""
  370. *-- Returns.....: None
  371. *-- Parameters..: nLine  = Line or Row for @/Say
  372. *--               nWidth = Width of screen
  373. *--               cColor = Colors to be used ("Forg/Back") (may be nul "", in
  374. *--                           order to use the default colors of window/screen)
  375. *--               cText  = Message to center on screen
  376. *-------------------------------------------------------------------------------
  377.     
  378.     parameters nLine,nWidth,cColor,cText
  379.     private nCol
  380.     
  381.     nCol = (nWidth - len(cText)) /2
  382.     @nLine,nCol say cText color &cColor.
  383.     
  384. RETURN
  385. *-- EoP: Center
  386.  
  387. FUNCTION Surround
  388. *-------------------------------------------------------------------------------
  389. *-- Programmer..: Miriam Liskin
  390. *-- Date........: 05/24/1991
  391. *-- Notes.......: Displays a message surrounded by a box anywhere on 
  392. *--               the screen
  393. *-- Written for.: dBASE IV, 1.1
  394. *-- Rev. History: 04/19/1991 - Modified by Ken Mayer (KENMAYER) to a function
  395. *--               from original procedure
  396. *-- Calls.......: None
  397. *-- Called by...: Any
  398. *-- Usage.......: surround(<nLine>,<nColumn>,"<cColor>","<cText>")
  399. *-- Example.....: cDummy = surround(5,12,"RG+/GB",;
  400. *--                        "Processing ... Do not Touch!")
  401. *-- Returns.....: Nul/""
  402. *-- Parameters..: nLine   = Line to display "surrounded" message at
  403. *--               nColumn = Column for same (X,Y coordinates for @SAY)
  404. *--               cColor  = Color variable/colors
  405. *--               cText   = Text to be displayed inside box
  406. *-------------------------------------------------------------------------------
  407.     
  408.     parameters nLine,nColumn,cColor,cText
  409.     
  410.     cText = " " + trim(cText) + " "             && add spaces around text
  411.     @nLine-1,nColumn-1 to nLine+1,nColumn+len(cText) double;
  412.         color &cColor.                           && draw box
  413.     @nLine,nColumn say cText color &cColor.  && disp. text
  414.     
  415. RETURN "" 
  416. *-- EoF: Surround()
  417.  
  418. *-------------------------------------------------------------------------------
  419. *-- End of Program: ERRLOG.PRG
  420. *-------------------------------------------------------------------------------
  421.